module Huffman (
  Huffman,
	obtenerFrecuencia,
	crearRama,
	crearHuffman,
	generarAsociaciones,
	reconstruirHuffman,
	codificar,
	decodificar
) where

data Huffman a = 
   -- | 'Hoja' Representa un nodo final en el árbol de Huffman,
   -- | e indica que el caracter 'a' posee 'Integer' repeticiones
      Hoja Integer a 
   -- | 'Rama' representa un nodo no final en el árbol de Huffman
   -- | e indica que la suma de ambos hijos totalizan 'Integer' 
   -- | repeticiones
    | Rama Integer (Huffman a) (Huffman a)
    deriving(Show)

   {- |
      'obtenerFrecuencia' recibe un árbol de Huffman cualquiera y retorna
      la frecuencica asociada al mismo   
   -}
obtenerFrecuencia :: Huffman a -> Integer
obtenerFrecuencia (Hoja r _) = r
obtenerFrecuencia (Rama r _ _) = r

    {- |
        'crearRama' toma dos árboles de Huffman y los junta, creando así una 
        rama que los contiene a ambos
    -}
crearRama :: Huffman a -> Huffman a -> Huffman a
crearRama a b = Rama ((obtenerFrecuencia a) + (obtenerFrecuencia b)) a b

    {- |
        'crearHuffman' toma un conjunto de tuplas que consisten en pares
        (caracter, repeticiones) y genera un árbol de Huffman asociado
        a dichos caracteres
    -}
crearHuffman :: Ord(a) => [(a, Integer)] -> Huffman a
crearHuffman tuplas = crearHuffmanDeHeap (foldr insertarHuffman [ArbolVacio] (map (\ (a, costo) -> (Hoja costo a)) tuplas))

    {- |
        'crearHuffmanDeHeap' toma un heap binomial que ordene un conjunto de
        árboles de Huffman y obtiene un árbol de Huffman que se puede formar
        a partir de dicho heap
    -}
crearHuffmanDeHeap :: (Ord a) => HeapBinomial a -> Huffman a
crearHuffmanDeHeap hb
  | length hb == 1 = (\ (RamaBinomial huffman _ _) -> huffman) (head hb)
  | otherwise = (\(h1, huffman1) 
                  ->(\(h2, huffman2) 
                      -> crearHuffmanDeHeap
                            (insertarHuffman (crearRama huffman1 huffman2)
                                              h2
                            )
                    )
                    (primerHuffman h1)
                )
                (primerHuffman hb)

    {- |
        'generarAsociaciones' toma como parámetro un árbol de Huffman y devuelve
        una lista de tuplas que corresponden a los caracteres presentes en el árbol
        junto con sus asociaciones
        Se apoya en una función recursiva llamada 'asociacionesRecursiva' que recibe
        de parámetros el árbol de Huffman a analizar y la lista de pasos que se han
        seguido para llegar hasta ese árbol. Retorna las tuplas deseadas
    -}
generarAsociaciones :: Huffman a -> [(a, [Bool])]
-- Aqui se trata el caso particular en el que el árbol de Huffman está compuesto
-- únicamente por una hoja
generarAsociaciones (Hoja _ el) = [(el, [True])]
generarAsociaciones huff = asociacionesRecursiva huff []
    where
        asociacionesRecursiva (Rama _ huffI huffD) l = 
            (asociacionesRecursiva huffI (l ++ [False])) ++ (asociacionesRecursiva huffD (l ++ [True]))
        asociacionesRecursiva (Hoja _ el) l = 
            [(el, l ++ [True])]
            
    {- |
        'reconstruirHuffman' corresponde a la función inversa de 'generarAsociaciones'.
        Se apoya en la función auxiliar 'insertarHoja', que recibe como parámetros
        un par que contiene un elemento y el camino que le falta por recorrer y un
        árbol de Huffman donde debe recorrer dicho camino. Devuelve el árbol de
        Huffman correspondiente a forzar la iserción del elemento, en la posición
        indicada, dentro del árbol
    -}
reconstruirHuffman :: [(a, [Bool])] -> Huffman a
reconstruirHuffman ((a, l):t) = foldr insertarHoja (Hoja 0 a) ((a, l):t)
    where
          insertarHoja (el, (False : t)) (Rama _ huffI huffD) =
              Rama 0 (insertarHoja (el, t) huffI) huffD
              
          insertarHoja (el, (False : t)) (Hoja _ _) = 
              Rama 0 (insertarHoja (el, t) (Hoja 0 el)) (Hoja 0 el)
                            
          insertarHoja (el, (True : t)) (Rama _ huffI huffD) =
              Rama 0 huffI (insertarHoja (el, t) huffD)
              
          insertarHoja (el, (True : t)) (Hoja _ _) =
              Rama 0 (Hoja 0 el) (insertarHoja (el, t) (Hoja 0 el))
              
          insertarHoja (el, []) _ = Hoja 0 el

    {- | 
        'codificar' recibe una lista de símbolos y devuelve una tupla que contiene
        el árbol de Huffman con el que se codificaron los símbolos y la cadena de
        elementos codificados      
    -}
codificar :: (Eq a, Ord a) => [a] -> (Huffman a, [Bool])
codificar list = procesarHuffman (crearHuffman (foldr agregarElemento [] list))
    where
        agregarElemento el [] = [(el, 1)]
        agregarElemento el0 ((el1, num):t)
            | (el0 == el1) = (el1, num + 1) : t
            | otherwise = (el1, num) : (agregarElemento el0 t)
            
        procesarHuffman huff = (huff, generarCodificado (generarAsociaciones huff))
            where
                generarCodificado asoc = (foldl codCaracter [] list)
                    where
                        codCaracter li ele = li ++ ((\(a, b) -> b) (head (dropWhile (\(a, b) -> a /= ele) asoc)))

   -- | Representación de una cola de prioridades utilizando un heap binomial
type HeapBinomial a = [ArbolBinomial a]

data ArbolBinomial a =
   -- | 'RamaBinomial' (elemento) (altura) (hijos)
   -- | Representa un árbol binomial no vacío cuyo elemento es un árbol de Huffman y
   -- | posee 'altura' hijos listados en 'hijos'
    RamaBinomial (Huffman a) Int [ArbolBinomial a]
   -- | 'ArbolVacio' representa un árbol binomial sin elementos
  | ArbolVacio
  deriving(Show)

    {- |
        'decodificar' toma un árbol de Huffman y una cadena que fue codificada con dicho árbol
        y retorna la cadena decodificada
    -}
decodificar :: Huffman a -> [Bool] -> [a]
decodificar huff string = encontrarMensaje (generarAsociaciones huff) string []
    where
          encontrarMensaje _ [] _ = []
          encontrarMensaje asoc (h:t) acc
              | hasElem (acc ++ [h]) huff = (getElem (acc ++ [h]) huff) : (encontrarMensaje asoc t [])
              | otherwise = encontrarMensaje asoc t (acc ++ [h])
              where
                    hasElem [] (Hoja _ _) = True
                    hasElem [] (Rama _ _ _) = False
                    hasElem (False:t) (Rama _ hI _) = hasElem t hI
                    hasElem (True:t) (Rama _ _ hD) = hasElem t hD
              
                    getElem [] (Hoja _ a) = a
                    getElem (False:t) (Rama _ hI _) = getElem t hI
                    getElem (True:t) (Rama _ _ hD) = getElem t hD
   {- |
     'unirArbolBinomial' une árboles binomiales que tengan la misma altura
     Recibe dos arboles binomiales y genera un nuevo árbol que respeta las propiedades de un heap
   -}
unirArbolBinomial :: (Ord a) => ArbolBinomial a -> ArbolBinomial a -> ArbolBinomial a
unirArbolBinomial (RamaBinomial huffmanA aA nA) (RamaBinomial huffmanB _ nB)
  | obtenerFrecuencia huffmanA < obtenerFrecuencia huffmanB = RamaBinomial huffmanA (aA + 1) ((RamaBinomial huffmanB aA nB) : nA)
  | otherwise = RamaBinomial huffmanB (aA + 1) ((RamaBinomial huffmanA aA nA) : nB)
unirArbolBinomial a ArbolVacio = a
unirArbolBinomial ArbolVacio a = a

   {- | 
    'mezclarHeapsBinomiales' toma como argumentos dos heaps binomiales representados
     con el tipo de datos anterior y retorna un nuevo heap resultante de unir los dos
     parámetros
   -}
mezclarHeapsBinomiales :: (Ord a) => HeapBinomial a -> HeapBinomial a -> HeapBinomial a
mezclarHeapsBinomiales hA hB = rtrim (foldr insertarArbolBinomial 
                                            (replicate (length h1 + 1) ArbolVacio) 
                                            arbolesUnificados)
  where
    h1 
        | length hA < length hB = hB 
        | otherwise = hA
    h2 
        | length hA < length hB = hA 
        | otherwise = hB
    arbolesUnificados = (zipWith unirArbolBinomial
                                 h1
                                 (h2 ++ (replicate (length h1 - length h2) ArbolVacio)))
    rtrim h
      | esArbolVacio (last h) = take ((length h) - 1) h
      | otherwise = h

   {- |
     'insertarArbolBinomial' recibe como parámetros un árbol binomial que cumpla 
     con las propiedades de un heap y lo inserta dentro del heap binomial que se 
     recibe como segundo parámetro
   -}
insertarArbolBinomial :: (Ord a) => ArbolBinomial a -> HeapBinomial a -> HeapBinomial a
insertarArbolBinomial (RamaBinomial huffmanA aA nA) h
  | esArbolVacio (h !! aA) = (take aA h) ++ [RamaBinomial huffmanA aA nA] ++ (drop (aA + 1) h)
  | otherwise = insertarArbolBinomial (unirArbolBinomial (RamaBinomial huffmanA aA nA)
                                                         (h !! aA)
                                      )
                                      ((take aA h) ++ [ArbolVacio] ++ (drop (aA + 1) h))
insertarArbolBinomial ArbolVacio h = h

   {- |
    'esArbolVacio' toma como parámetro un árbol binomial e indica si el mismo
    fue construido con el constructor ArbolVacio
   -}
esArbolVacio :: ArbolBinomial a -> Bool
esArbolVacio ArbolVacio = True
esArbolVacio (RamaBinomial _ _ _) = False

   {- |
    'insertarHuffman' recibe como parámetro un árbol de Huffman y lo inserta dentro
    del heap binomial que se recibe como segundo parámetro. 
    Esta función no es característica de los heap binomiales, pero resulta útil
    para el uso que se la va a dar a los mismos
   -}
insertarHuffman :: (Ord a) => Huffman a -> HeapBinomial a -> HeapBinomial a
insertarHuffman a h = mezclarHeapsBinomiales [RamaBinomial a 0 []] h

   {- |
    'primerHuffman' recibe como parámetro un heap binomial que ordena árboles
    de Huffman y retorna un par que contiene, en su primera posición, el heap
    resultante de extraer el árbol de Huffman de menor valor del heap, y en
    su segunda posición el árbol de Huffman extraído
   -}
primerHuffman :: (Ord a) => HeapBinomial a -> (HeapBinomial a, Huffman a)
primerHuffman h = completarHeap hR arbolMinimo
  where
    m = minimoArbolBinomial h
    arbolMinimo = head (dropWhile noEsMinimo h)
    -- heap sin el arbol binomial que contiene el huffman mínimo
    hR = (takeWhile noEsMinimo h) ++ [ArbolVacio] ++ (tail (dropWhile noEsMinimo h))
    noEsMinimo ArbolVacio = True
    noEsMinimo (RamaBinomial huffman _ _) = (obtenerFrecuencia huffman) /= m

   {- |
    'completarHeap' es una función auxiliar que recibe como parámetros un heap binomial
    que ordena árboles de Huffman y un árbol binomial cuyos nodos son árboles
    de Huffman y retorna una tupla que contiene, en su primera posición, el heap que
    resulta de insertar todos los hijos del segundo parámetro en el primero, y en 
    su segunda posición, el árbol de Huffman contenido en la cabecera del segundo parámetro
   -}
completarHeap :: (Ord a) => HeapBinomial a -> ArbolBinomial a -> (HeapBinomial a, Huffman a)
completarHeap h (RamaBinomial huffman costo arboles) = (reverse (dropWhile esArbolVacio (reverse (foldr insertarArbolBinomial h arboles))), huffman)


   {- |
    'minimoArbolBinomial' obtiene el valor del árbol de Huffman más bajo que
    existe en el heap
   -}
minimoArbolBinomial :: (Ord a) => HeapBinomial a -> Integer
minimoArbolBinomial h = foldr compararArbolesBinomiales (-1) h
  where
    compararArbolesBinomiales ArbolVacio o = o
    compararArbolesBinomiales (RamaBinomial huffmanA aA nA) (-1) = obtenerFrecuencia huffmanA
    compararArbolesBinomiales (RamaBinomial huffmanA aA nA) o
      | obtenerFrecuencia huffmanA < o = obtenerFrecuencia huffmanA
      | otherwise = o

